home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / DblClickAux.tcl < prev    next >
Text File  |  1995-12-22  |  10KB  |  300 lines
  1. #############################################################################
  2. # General utility procs (originally for TeX, BibTeX and Perl modes)
  3. #
  4. # Authors: Tom Pollard <pollard@chem.columbia.edu>
  5. #          Tom Scavo   <trscavo@syr.edu>
  6. #
  7. #############################################################################
  8.  
  9. #############################################################################
  10. # Take any valid Macintosh filespec as input, and return the
  11. # corresponding absolute filespec.  Filenames without an explicit
  12. # folder are resolved relative to the folder of the current document.
  13. #
  14. proc absolutePath {filename}    {
  15.     set    name [file tail    $filename]
  16.     set    subdir [file dirname $filename]
  17.     if { [string length $subdir] > 0 && [string index $subdir 0] != ":" } {
  18.         set    dir    ""
  19.     } else {
  20.         set    dir    [file dirname [lindex [winNames    -f]    0]]
  21.     }
  22.     return    "$dir$subdir:$name"
  23. }
  24.  
  25. #############################################################################
  26. # Open the file specified by the full pathname "$filename"
  27. # If it's already open, just switch to it without any fuss.
  28. #
  29. proc openFileQuietly {filename}    {
  30.     if {[lsearch [winNames -f]    $filename] >= 0} {
  31.         bringToFront $filename
  32.     } elseif {[file exists $filename]} {
  33.         edit -w    $filename
  34.     } else {
  35.         error "Couldn''t find \"$filename\""
  36.     }
  37. }
  38.  
  39. #############################################################################
  40. # Returns the position in $filename of the sought-after string.  
  41. # A value of -1 is returned if the file or string are missing.
  42. #
  43. proc searchInFile {filename searchString} {
  44.     if {[lsearch [winNames -f]    $filename] >= 0} {
  45.         set fileText [getText -w $filename 0 [maxPos -w $filename]]
  46.         
  47.     } elseif {[file exists $filename]} {
  48.         set fd [open $filename]
  49.         set fileText [read $fd]
  50.         close $fd
  51.         
  52.     } else {
  53.         return -1
  54.     }
  55.     
  56.     # Search the file for the search string, returning position of
  57.     # first match if found.
  58.     message "searching $filename..."
  59.     if {[regexp -indices $searchString $fileText mtch]} {
  60.         return [lindex $mtch 0]
  61.     } else {        
  62.         return -1
  63.     }
  64. }
  65.  
  66. #############################################################################
  67. #  Read and return the complete contents of the specified file.
  68. #
  69. proc readFile {fileName} {
  70.     if {[file exists $fileName] && [file readable $fileName]} {
  71.        set fileid [open $fileName "r"]
  72.        set contents [read $fileid]
  73.        close $fileid
  74.        return $contents
  75.     } else {
  76.        error "No readable file found"
  77.     }
  78. }
  79.  
  80. #############################################################################
  81. #  Highlight (select) a particular line in the designated file, opening the
  82. #  file if necessary.  Returns the full name of the buffer containing the
  83. #  opened file.  If provided, a message is displayed on the status line.
  84. #
  85. proc gotoFileLine {fname line {mesg {}}} {
  86.     if {[expr {[lsearch [winNames -f] "*$fname"] >= 0}]} {
  87.         bringToFront $fname
  88.     } elseif {[expr {[lsearch [winNames] "*$fname"] >= 0}]} {
  89.         bringToFront $fname
  90.     } elseif {[file exists $fname]} {
  91.         edit $fname
  92.         newMode Perl
  93.         catch {shrinkWindow 2}
  94.     } else {
  95.         alertnote "File \" $fname \" not found."
  96.         return
  97.     }
  98.     set pos [rowColToPos $line 0]
  99.     select [lineStart $pos] [nextLineStart $pos]
  100.     if {[string length $mesg]} { message $mesg }
  101.     return [lindex [winNames -f] 0]
  102. }
  103.  
  104. ###########################################################################
  105. #  Parse a string into "word"s, which include blocks of non-space text,
  106. #  double- and single-quoted strings, and blocks of text enclosed in 
  107. #  balanced parentheses or curly brackets.
  108. #
  109. #  If a word is delimited by a quote or paren character (\", \', \(, or \{),
  110. #  then _that_ particular delimiter may be included within the word if it is 
  111. #  backslash-quoted, as above.  No other characters are special or need quoting
  112. #  with that word.  The quoted delimiters are unquoted in the list of words 
  113. #  returned.  
  114. #
  115. proc parseWords {entry} {
  116.     set slash "\\"
  117.     set qslash "\\\\"
  118.     
  119.     set words {}
  120.     set entry [string trim $entry]
  121.  
  122.     while {[string length $entry]} {
  123.         set delim [string range $entry 0 0]
  124.         set entry [string range $entry 1 end]
  125.  
  126. #        regexp $endPat   matches the end of the word
  127. #               $openPat  matches the open delimiter
  128. #               $unescPat matches escaped instances of the open/close delimiters
  129. #
  130. #        $type == "quote" means open/close delimiters are the same
  131. #              == "paren" means there's a close delimiter and nesting is possible
  132. #              == "unquoted" means the word is delimited by whitespace.
  133. #
  134.         if {$delim == {"}} {            set endPat {^([^"]*)"}
  135.                                         set unescPat {\\(")}
  136.                                         set type quote
  137.             
  138.         } elseif {$delim == {'}} {        set endPat {^([^']*)'}
  139.                                         set unescPat {\\(')}
  140.                                         set type quote
  141.             
  142.         } elseif {$delim == "\{"} {        set endPat "^(\[^\}\]*)\}"
  143.                                         set openPat "\{"
  144.                                         set unescPat "\\\\(\[\{\}\])"
  145.                                         set type paren
  146.             
  147.         } elseif {$delim == "("} {        set endPat {^([^)]*)\)}
  148.                                         set openPat {(}
  149.                                         set unescPat {\\([()])}
  150.                                         set type paren
  151.                                         
  152.         } else {                        set type unquoted
  153.         }
  154.         
  155.         if {$type == "quote"} {
  156.             set ck $qslash
  157.             set fld ""
  158.             while {$ck == $qslash} {
  159.                 set ok [regexp -indices $endPat $entry mtch sub1]
  160.                 if {$ok} {
  161.                     append fld [string range $entry [lindex $mtch 0] [lindex $mtch 1]]
  162.                     set ck $slash[string range $entry [lindex $sub1 1] [lindex $sub1 1]]
  163.                     set pos [expr 1 + [lindex $mtch 1]]
  164.                     set entry [string range $entry $pos end]
  165.                 } else {
  166.                     error "Couldn't match $delim as field delimiter"
  167.                 }
  168.             }
  169.             set pos [expr [string length $fld] - 2]
  170.             set fld [string range $fld 0 $pos]
  171.             regsub -all $unescPat $fld {\1} fld
  172.            
  173.         } elseif {$type == "paren"} {
  174.         
  175.             set nopen 1
  176.             set nclose 0
  177.             set fld ""
  178.             while {$nopen - $nclose != 0} {
  179.                 set ok [regexp -indices $endPat $entry mtch sub1]
  180.                 if {$ok} {
  181.                     append fld [string range $entry [lindex $mtch 0] [lindex $mtch 1]]
  182.                     set ck $slash[string range $entry [lindex $sub1 1] [lindex $sub1 1]]
  183.                     set entry [string range $entry [expr 1 + [lindex $mtch 1]] end]
  184.                     regsub -all $unescPat $fld {} fld1
  185.                     set nopen [llength [split $fld1 $openPat]]
  186.                     if {$ck != $qslash} { incr nclose }
  187.                 } else {
  188.                     error "Couldn't match $delim as field delimiter"
  189.                 } 
  190.             }
  191.             set pos [expr [string length $fld] - 2]
  192.             set fld [string range $fld 0 $pos]
  193.             regsub -all $unescPat $fld {\1} fld
  194.  
  195.         } elseif {$type == "unquoted"} {
  196.         
  197.             set entry ${delim}${entry}
  198.             set ok [regexp -indices {^([^     ]*)} $entry mtch sub1]
  199.             if {$ok} {
  200.                 set fld [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
  201.                 set pos [expr 1 + [lindex $mtch 1]]
  202.                 set entry [string range $entry $pos end]
  203.             } else {
  204.                 set fld ""
  205.                 set entry ""
  206.             }
  207.         } else {
  208.             error "parseWords: unrecognized case"
  209.         }
  210.     
  211.         lappend words $fld
  212.         set entry [string trimleft $entry]
  213.     }
  214.     return $words
  215. }
  216.  
  217. #############################################################################
  218. #  This is a generally useful proc that builds a hierarchical menu 
  219. #  from the files in a given folder and all subfolders.  As the menu is
  220. #  built, the pathnames of the various files are saved in the array
  221. #  indicated  by $filePaths.  The index of the file's path in this array
  222. #  is formed by concatenating the submenu name and filename, allowing the
  223. #  pathname to be retrieved by the procedure $proc when the menu item is
  224. #  selected.
  225. #
  226. proc buildSubMenu {folder name proc filePaths {subMenuDepth 3}} {
  227.     global $filePaths
  228.     if {[file exists $folder]} {
  229.         if {![file isdirectory $folder]} {
  230.             set folder "[file dirname $folder]:"
  231.         }
  232.         if {[string length [file tail $folder]] > 0} {
  233.             set folder "$folder:"
  234.         }
  235.         if {$name == 0} {
  236.             set name [file tail [file dirname $folder]]
  237.         }
  238.         if {$proc == 0} {
  239.             set pproc ""
  240.         } else {
  241.             set pproc "-p $proc"
  242.         }
  243.         set menu {}
  244.           incr subMenuDepth -1
  245.         set filenames [glob -nocomplain  $folder\*]
  246.         if {[llength $filenames] > 0} {
  247.            foreach m $filenames {
  248.               if {[file isdirectory $m] && $subMenuDepth > 0} {
  249.                   lappend menu [buildSubMenu ${m}: 0 $proc $filePaths $subMenuDepth] 
  250.               } elseif {[file isfile $m]} {
  251.                   set fname [file tail $m]
  252.                   lappend menu $fname
  253.                   set ${filePaths}($name:$fname) $m
  254.               }
  255.              }
  256.         }
  257.         return [concat {menu -m -n} [list $name] $pproc [list $menu]]
  258.     } else {
  259.         alertnote "Folder \"$folder\" is missing"
  260.         return {}
  261.     }
  262. }
  263.  
  264. #############################################################################
  265. # Return a list of all subfolders found within $folder,
  266. # down to some maximum recursion depth.  The top-level
  267. # folder is not included in the returned list.
  268. #
  269. proc listSubfolders {folder {depth 3}} {
  270.     set folders {}
  271.     if {$depth > 0} {
  272.         incr depth -1
  273.         if {[string length [file tail $folder]] > 0} {
  274.             set folder "$folder:"
  275.         }
  276.         foreach m [glob -nocomplain  $folder\*] {
  277.             if {[file isdirectory $m]} {
  278.                 set folders [concat $folders [list $m]]
  279.                 set folders [concat $folders [listSubfolders ${m}: $depth]]
  280.             }
  281.         }
  282.     }
  283.     return $folders
  284. }
  285.  
  286. #############################################################################
  287.  
  288. proc commandClick {from to url} {
  289.     select $from
  290.     for {set i 0} {$i < 200} {incr i} {}
  291.     select $from $to
  292.     for {set i 0} {$i < 200} {incr i} {}
  293.     select $from
  294.     for {set i 0} {$i < 200} {incr i} {}
  295.     select $from $to
  296.     icURL $url
  297. }    
  298.  
  299.  
  300.